home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
DB_CLIPP
/
1159.ZIP
/
OSSMOD.PRG
< prev
next >
Wrap
Text File
|
1987-02-10
|
8KB
|
347 lines
SET BELL OFF
DAT=DATE()
PUBLIC CALOVER
CALOVER=0
TOTALREC=1
SET SAFETY OFF
SET EXACT ON
SET DELETED ON
@ 23,34 SAY 'WORKING . . .'
SELECT 2
APPEND BLANK
REPLACE SUBCATID WITH A->SUBCATID
REPLACE INST_TYPE WITH A->INST_TYPE
REPLACE CALIB_DATE WITH A->CALIB_DATE
REPLACE BY_DATE WITH A->BY_DATE
REPLACE CAL_DUE_DT WITH A->CAL_DUE_DT
REPLACE LOCATION WITH A->LOCATION
REPLACE REMARK WITH A->REMARK
REPLACE CALIB_INT WITH A->CALIB_INT
REPLACE SERIAL_NO WITH A->SERIAL_NO
REPLACE TVA_NO WITH A->TVA_NO
IF DUPREC='N'
SET FORMAT TO REPMODIN.FMT
ELSE
SET FORMAT TO REPMODY.FMT
ENDIF
X=0
DO WHILE X<1
EDIT
N4='K'
DO WHILE N4#'Y'.AND.N4#'N'
CLEAR
?
?
?
?
?
WAIT ' Do you want to make any more changes to this record ? (Y/N)';
TO N4
N4=UPPER(N4)
IF N4#'Y'.AND.N4#'N'
LOOP
ENDIF
ENDDO
IF N4='Y'
LOOP
ENDIF
IF N4='N'
CLEAR
@ 1,16 SAY 'Data base in use: '
?? OSS
@ 3,0
?'The record changes are now being processed, and checked. If they are'
?'okay, they will automatically be added to the main data base.'
?
?
?
?
?' ONE MOMENT PLEASE'
?
?' ________________________________________'
?' | |'
?' | PLEASE DO NOT PRESS ANY KEYS YET |'
?' |________________________________________|'
?
?
GO 1
IF LEN(TRIM(INST_TYPE))=0
DO REPWKZAP
RETURN
ENDIF
GO TOP
YR=YEAR(DAT)
MO=MONTH(DAT)
DY=DAY(DAT)
DO WHILE .NOT.EOF()
CVAR=LTRIM(TRIM(UPPER(COMLINE)))
REPLACE SUBCATID WITH UPPER(LTRIM(SUBCATID))
REPLACE SERIAL_NO WITH UPPER(LTRIM(SERIAL_NO))
REPLACE TVA_NO WITH UPPER(LTRIM(TVA_NO))
IF TVAID='Y'
IF ' ' $ TRIM(TVA_NO)
VSTR=TRIM(TVA_NO)
DO WHILE ' ' $ VSTR
P=AT(' ',VSTR)
VSTR=LEFT(VSTR,P-1)+RIGHT(VSTR,LEN(VSTR)-P)
ENDDO
REPLACE TVA_NO WITH VSTR
ENDIF
ENDIF
IF SERID='Y'
IF ' ' $ TRIM(SERIAL_NO)
VSTR=TRIM(SERIAL_NO)
DO WHILE ' ' $ VSTR
P=AT(' ',VSTR)
VSTR=LEFT(VSTR,P-1)+RIGHT(VSTR,LEN(VSTR)-P)
ENDDO
REPLACE SERIAL_NO WITH VSTR
ENDIF
ENDIF
IF '.D.' $ CVAR.OR.'.E.' $ CVAR
REPLACE REMARK WITH ' '
IF LEN(CVAR)<4
CVAR=' '
ENDIF
ENDIF
IF '.' $ CVAR
IF '2' $ CVAR
REPLACE CALIB_INT WITH 99
REPLACE BY_DATE WITH 0
IF '.ED.' $ CVAR.OR.'.DD.' $ CVAR
REPLACE CALIB_DATE WITH CTOD(' / / ')
REPLACE CAL_DUE_DT WITH CALIB_DATE
ENDIF
REPLACE COMLINE WITH ' '
EXIT
ENDIF
IF '3' $ CVAR
REPLACE CALIB_INT WITH 0
REPLACE BY_DATE WITH 0
IF '.ED.' $ CVAR.OR.'.DD.' $ CVAR
REPLACE CALIB_DATE WITH CTOD(' / / ')
REPLACE CAL_DUE_DT WITH CALIB_DATE
ENDIF
REPLACE COMLINE WITH ' '
EXIT
ENDIF
DO CASE
CASE '.OF.' $ CVAR.OR.'.0F.' $ CVAR
CALOVER=0
REPLACE BY_DATE WITH CALOVER
CASE '.PO.' $ CVAR
CALOVER=200
REPLACE BY_DATE WITH CALOVER
REPLACE COMLINE WITH ' '
EXIT
CASE '.P0.' $ CVAR
CALOVER=200
REPLACE BY_DATE WITH CALOVER
REPLACE COMLINE WITH ' '
EXIT
CASE '.O.' $ CVAR
CALOVER=100
REPLACE BY_DATE WITH CALOVER
REPLACE COMLINE WITH ' '
EXIT
CASE '.0.' $ CVAR
CALOVER=100
REPLACE BY_DATE WITH CALOVER
REPLACE COMLINE WITH ' '
EXIT
ENDCASE
IF ('.ED.' $ CVAR.OR.'.DD.' $ CVAR).AND.(CALIB_INT=0.OR.CALIB_INT=99)
REPLACE CALIB_DATE WITH CTOD(' / / ')
REPLACE CAL_DUE_DT WITH CALIB_DATE
REPLACE BY_DATE WITH 0
REPLACE COMLINE WITH ' '
EXIT
ENDIF
ENDIF
IF CALIB_INT=99 .OR. CALIB_INT=0
REPLACE BY_DATE WITH 0
REPLACE COMLINE WITH ' '
EXIT
ENDIF
REPLACE COMLINE WITH ' '
IF YEAR(CALIB_DATE)+100-YEAR(DAT)<10
MOCALDT=MONTH(CALIB_DATE)
DYCALDT=DAY(CALIB_DATE)
YRCALDT=INT(YEAR(CALIB_DATE)+100+.5)
IF MOCALDT<10
M=1
ELSE
M=2
ENDIF
IF DYCALDT<10
D=1
ELSE
D=2
ENDIF
REPLACE CALIB_DATE WITH CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+;
STR(YRCALDT,4,0))
ENDIF
IF YEAR(CAL_DUE_DT)+100-YEAR(DAT)<10
MOCALDT=MONTH(CAL_DUE_DT)
DYCALDT=DAY(CAL_DUE_DT)
YRCALDT=INT(YEAR(CAL_DUE_DT)+100+.5)
IF MOCALDT<10
M=1
ELSE
M=2
ENDIF
IF DYCALDT<10
D=1
ELSE
D=2
ENDIF
REPLACE CAL_DUE_DT WITH CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+;
STR(YRCALDT,4,0))
ENDIF
TCOMP=YR*365.24+MO*30.44+DY
TDCOMP=YR*365.24+(MO-CALIB_INT)*30.44+DY
CDCOMP=YEAR(CALIB_DATE)*365.24+MONTH(CALIB_DATE)*30.44+DAY(CALIB_DATE)
CALDUEP=CDCOMP+CALIB_INT*30.44-5
CALDUDT=YEAR(CAL_DUE_DT)*365.24+MONTH(CAL_DUE_DT)*30.44+DAY(CAL_DUE_DT)
IF BY_DATE#200.AND.CALOVER=0
IF TDCOMP>CDCOMP.OR.CDCOMP>TCOMP
DO REPCALDT
LOOP
ENDIF
YRDUE=YEAR(CALIB_DATE)
MODUE=MONTH(CALIB_DATE)+CALIB_INT
DYDUE=DAY(CALIB_DATE)
IF MODUE>12
YRDUE=YRDUE+INT(MODUE/12)
MODUE=INT(MODUE-INT(MODUE/12)*12+.5)
ENDIF
M=1
IF MODUE>9
M=2
ENDIF
D=2
IF DYDUE<10
D=1
ENDIF
DATDU=STR(MODUE,M,0)+'/'+STR(DYDUE,D,0)+'/'+STR(YRDUE,4,0)
CALCDUDT=CTOD(DATDU)
CALDUETY=YEAR(CALCDUDT)*365.24+MONTH(CALCDUDT)*30.44+DAY(CALCDUDT)
IF (CALDUDT>CALDUETY.OR.CALDUDT<CALDUEP).AND.CALIB_INT#99
DO REPCALDU
LOOP
ENDIF
IF BY_DATE#200
REPLACE BY_DATE WITH CALDUDT-1
ENDIF
ENDIF
CALOVER=0
EXIT
ENDDO
SELECT 1
RECNUM1=RECNO()
REPLACE SUBCATID WITH LTRIM(B->SUBCATID)
REPLACE INST_TYPE WITH LTRIM(B->INST_TYPE)
REPLACE CALIB_DATE WITH B->CALIB_DATE
REPLACE CAL_DUE_DT WITH B->CAL_DUE_DT
REPLACE LOCATION WITH B->LOCATION
REPLACE REMARK WITH B->REMARK
REPLACE CALIB_INT WITH B->CALIB_INT
REPLACE BY_DATE WITH B->BY_DATE
REPLACE SERIAL_NO WITH B->SERIAL_NO
REPLACE LAST_UPDAT WITH DAT
SELECT 2
ZAP
SET BELL ON
SELECT 1
SET DELETED ON
CLEAR
GO RECNUM1
@ 1,25 SAY 'Data base in use: '
?? OSS
@ 3,0 SAY INSTNAME
@ 3,23 SAY SERIALNUM
@ 3,40 SAY TVANUMBER
@ 3,57 SAY CALIBDATE
@ 3,70 SAY 'NEXT DATE'
DO CASE
CASE BY_DATE=100
@ 5,56 SAY TDREMARK
CASE BY_DATE=200
@ 5,58 SAY DREMARK
ENDCASE
@ 6,0 SAY INST_TYPE
@ 6,23 SAY SERIAL_NO
@ 6,40 SAY TVA_NO
@ 6,58 SAY CALIB_DATE
@ 6,70 SAY CAL_DUE_DT
PT=0
IF CAT3ABB $ SUBCATID
?'/'
?? CATEGORY3
??'/ '
PT=1
ENDIF
IF SUB1ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT1
??') '
PT=1
ELSE
??'('
?? SUBCAT1
??') '
ENDIF
ENDIF
IF SUB2ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT2
??') '
PT=1
ELSE
??'('
?? SUBCAT2
??') '
ENDIF
ENDIF
IF SUB3ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT3
??') '
ELSE
??'('
?? SUBCAT3
??') '
ENDIF
ENDIF
@ 9,0 SAY LOCATNAME
??': '
?? LOCATION
IF CALIB_INT>0.AND.CALIB_INT<99
??' '
?? CALINTERVL
??': '
?? CALIB_INT
??' months'
ENDIF
DO CASE
CASE CALIB_INT=99
@ 9,60 SAY '/'
?? CATEGORY2
??'/'
CASE CALIB_INT=0
@ 9,60 SAY '/'
?? CATEGORY3
??'/'
ENDCASE
@ 11,0 SAY REMARK
@ 14,0 SAY 'LAST UPDATE:'
@ 14,14 SAY LAST_UPDAT
RETURN
ENDIF
ENDDO
RETURN